home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Multiple R184024152001.psc / chatserver.bas < prev    next >
Encoding:
BASIC Source File  |  2001-04-15  |  4.9 KB  |  186 lines
  1. Attribute VB_Name = "chatserv"
  2. Public NuM As Integer
  3. Public NuM2 As Integer
  4.  
  5. Type user1
  6. chan As String
  7. ListIndex As Integer
  8. un As String
  9. End Type
  10.  
  11. Type chans1
  12. chan As String
  13. users As Integer
  14. uns As String
  15. pw As String
  16. End Type
  17.  
  18. Public chans(1000) As chans1
  19. Public user(1000) As user1
  20.  
  21. Function msg(message As String, Optional clr As String = vbBlack, Optional bld As Boolean = False, Optional sze As Long = 10)
  22. Form1.RichTextBox1.SelStart = Len(Form1.RichTextBox1.Text)
  23. Form1.RichTextBox1.SelColor = clr
  24. Form1.RichTextBox1.SelFontSize = sze
  25. Form1.RichTextBox1.SelBold = bld
  26. Form1.RichTextBox1.SelText = message & vbCrLf
  27. End Function
  28.  
  29. Function send(prt As Integer, dat As String, Optional showmsg As Boolean = True)
  30. If Form1.host(prt).State = 7 Then Form1.host(prt).SendData dat
  31. If Form1.host(prt).State = 8 Then Form1.host(prt).Close
  32. stri$ = dat
  33. If showmsg = True Then msg stri$, vbRed
  34. DoEvents
  35. End Function
  36.  
  37. Function Sendchans(prt2 As Integer)
  38. For i = 0 To NuM2
  39. If chans(i).chan <> "" Then m$ = m$ & chans(i).users & "," & chans(i).chan & ";" & chans(i).pw & ">"
  40. Next i
  41. send prt2, "400 " & m$
  42.  
  43. End Function
  44.  
  45. Function addnicktochan(ind As Integer, thechan As String)
  46. If user(ind).chan = "" Then GoTo nxt2:
  47. For i = 1 To Len(chans(user(ind).ListIndex).uns)
  48.     m$ = Mid(chans(user(ind).ListIndex).uns, i, 1)
  49.     If m$ = ";" Then
  50.         If user(ind).un = t$ Then
  51.             chans(user(ind).ListIndex).uns = Left(chans(user(ind).ListIndex).uns, i - Len(user(ind).un)) & Right(chans(user(ind).ListIndex).uns, Len(chans(user(ind).ListIndex).uns) - Len(user(ind).un) - i)
  52.             GoTo nxt2:
  53.         End If
  54.     Else
  55.     t$ = t$ & m$
  56.     End If
  57. Next i
  58. nxt2:
  59. For i = 0 To Form1.List2.ListCount - 1
  60.     If thechan = Form1.List2.List(i) Then
  61.         user(ind).ListIndex = i
  62.         GoTo nxt:
  63.     End If
  64. Next i
  65. nxt:
  66. chans(user(ind).ListIndex).uns = chans(user(ind).ListIndex).uns & user(ind).un & ";"
  67. chans(user(ind).ListIndex).users = chans(user(ind).ListIndex).users + 1
  68. refreshlist
  69. user(ind).chan = thechan
  70. End Function
  71.  
  72. Function refreshlist()
  73. Form1.List2.Clear
  74. Form1.List3.Clear
  75. For i = 0 To NuM2
  76.     If chans(i).chan <> "" Then
  77.     Form1.List2.AddItem chans(i).chan
  78.     Form1.List3.AddItem chans(i).users
  79.     End If
  80. Next i
  81. End Function
  82.  
  83. Function remnickfromchan(ind As Integer)
  84. If user(ind).chan = "" Then GoTo nxt2:
  85. For i = 1 To Len(chans(user(ind).ListIndex).uns)
  86.     m$ = Mid(chans(user(ind).ListIndex).uns, i, 1)
  87.     If m$ = ";" Then
  88.     tt$ = t$
  89.     t$ = ""
  90.         If user(ind).un = tt$ Then
  91.         Dim uns As String
  92.         uns = chans(user(ind).ListIndex).uns
  93.             uns = Left(uns, i - Len(user(ind).un) - 1) & Right(uns, Len(uns) - i)
  94.             chans(user(ind).ListIndex).uns = uns
  95.             chans(user(ind).ListIndex).users = chans(user(ind).ListIndex).users - 1
  96.             refreshlist
  97.             If chans(user(ind).ListIndex).users <> 0 Then senduserlist ind
  98.             user(ind).chan = ""
  99.             If chans(user(ind).ListIndex).users = 0 Then
  100.                 If chans(user(ind).ListIndex).chan <> "main" Then
  101.                     remchan (chans(user(ind).ListIndex).chan)
  102.                 End If
  103.             End If
  104.             GoTo nxt2:
  105.         End If
  106.     Else
  107.     t$ = t$ & m$
  108.     End If
  109. Next i
  110. nxt2:
  111. send ind, "800 "
  112. refreshlist
  113. End Function
  114.  
  115. Function sendmsginchan(theind As Integer, thedat As String)
  116. Dim i As Integer
  117. For i = 1 To NuM
  118.     If Form1.host(i).State = 7 Then
  119.     If user(i).chan = user(theind).chan Then send i, thedat, False
  120.     End If
  121. Next i
  122. End Function
  123.  
  124.  
  125. Function senduserlist(userind As Integer)
  126. Dim i As Integer
  127. For i = 1 To NuM
  128.     If Form1.host(i).State = 7 Then
  129.     If user(i).chan = user(userind).chan Then send i, "lst " & chans(user(userind).ListIndex).uns, False
  130.     End If
  131. Next i
  132. End Function
  133.  
  134. Function sendall(thedat As String)
  135. Dim i As Integer
  136. For i = 1 To NuM
  137.     If Form1.host(i).State = 7 Then send i, thedat
  138. Next i
  139. End Function
  140.  
  141. Function addchan(thename As String) As Boolean
  142. For i = 1 To Len(thename)
  143. m$ = Mid(thename, i, 1)
  144.     If m$ = "," Then
  145.         room$ = t$
  146.         pw$ = Right(thename, Len(thename) - Len(room$) - 1)
  147.         GoTo nxt:
  148.     Else
  149.     t$ = t$ & m$
  150.     End If
  151. Next i
  152. nxt:
  153. For i = 0 To NuM2
  154.     If chans(i).chan = room$ Then
  155.         addchan = False
  156.         Exit Function
  157.     End If
  158. Next i
  159. For i = 0 To NuM2
  160.     If chans(i).chan = "" Then
  161.         chans(i).chan = room$
  162.         chans(NuM2).users = 0
  163.         If pw$ <> "" Then chans(i).pw = pw$
  164.         addchan = True
  165.         Exit Function
  166.     End If
  167. Next i
  168. NuM2 = NuM2 + 1
  169. chans(NuM2).chan = room$
  170. chans(NuM2).users = 0
  171. If pw$ <> "" Then chans(NuM2).pw = pw$
  172. addchan = True
  173. End Function
  174.  
  175. Function remchan(thename As String)
  176. For i = 0 To NuM2
  177. If thename = chans(i).chan Then
  178.     chans(i).chan = ""
  179.     chans(i).uns = ""
  180.     chans(i).users = 0
  181.     chans(i).pw = ""
  182. End If
  183. Next i
  184.  
  185. End Function
  186.